home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / update1a / frmabout.frm (.txt) < prev    next >
Visual Basic Form  |  1999-07-26  |  9KB  |  181 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About <Your Program Name Here>"
  5.    ClientHeight    =   1176
  6.    ClientLeft      =   48
  7.    ClientTop       =   336
  8.    ClientWidth     =   4644
  9.    ClipControls    =   0   'False
  10.    ControlBox      =   0   'False
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   1176
  15.    ScaleWidth      =   4644
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   2  'CenterScreen
  18.    Tag             =   "About KF4ZPB Web Browser"
  19.    Begin VB.CommandButton Exit 
  20.       Caption         =   "&OK"
  21.       Height          =   372
  22.       Left            =   2880
  23.       TabIndex        =   4
  24.       Top             =   120
  25.       Width           =   1692
  26.    End
  27.    Begin VB.CommandButton SysInfo 
  28.       Caption         =   "&System Information"
  29.       Height          =   372
  30.       Left            =   2880
  31.       TabIndex        =   3
  32.       Top             =   720
  33.       Width           =   1692
  34.    End
  35.    Begin VB.Label Label1 
  36.       Caption         =   "This program is FREEWARE"
  37.       Height          =   372
  38.       Left            =   120
  39.       TabIndex        =   2
  40.       Top             =   120
  41.       Width           =   2652
  42.    End
  43.    Begin VB.Label lblDescription 
  44.       Caption         =   "Viewing Website's and Webpage's"
  45.       ForeColor       =   &H00000000&
  46.       Height          =   324
  47.       Left            =   120
  48.       TabIndex        =   1
  49.       Tag             =   "App Description"
  50.       Top             =   840
  51.       Width           =   2652
  52.    End
  53.    Begin VB.Label lblVersion 
  54.       Caption         =   "Version"
  55.       Height          =   348
  56.       Left            =   120
  57.       TabIndex        =   0
  58.       Tag             =   "Version"
  59.       Top             =   480
  60.       Width           =   2652
  61.    End
  62. Attribute VB_Name = "frmAbout"
  63. Attribute VB_GlobalNameSpace = False
  64. Attribute VB_Creatable = False
  65. Attribute VB_PredeclaredId = True
  66. Attribute VB_Exposed = False
  67. ' Reg Key Security Options...
  68. Const KEY_ALL_ACCESS = &H2003F
  69.                                           
  70. ' Reg Key ROOT Types...
  71. Const HKEY_LOCAL_MACHINE = &H80000002
  72. Const ERROR_SUCCESS = 0
  73. Const REG_SZ = 1                         ' Unicode nul terminated string
  74. Const REG_DWORD = 4                      ' 32-bit number
  75. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  76. Const gREGVALSYSINFOLOC = "MSINFO"
  77. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  78. Const gREGVALSYSINFO = "PATH"
  79. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  80. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  81. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  82. Private Sub Command1_Click()
  83. End Sub
  84. Private Sub info_Click()
  85.     Msg = "Name: Carroll Dearstone ; E-Mail: cdearstone@yahoo.com ; Web Page: http://www.telery.com/kf4zpb/"
  86.     MsgTitle = "Author's Contact Information"
  87.     prompt = MsgBox(Msg, vbOKOnly, MsgTitle)
  88.     Msg = "This program is protected by copyright laws.  Warrenty Info: The author is not responsible for any damage done to your computer.  It is distributed AS IS."
  89.     MsgTitle = "Warning: Please read the following message."
  90.     prompt = MsgBox(Msg, vbOKOnly, MsgTitle)
  91. End Sub
  92. Private Sub Form_Load()
  93.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  94. End Sub
  95. Private Sub Exit_Click()
  96.         Unload Me
  97. End Sub
  98. Public Sub StartSysInfo()
  99.     On Error GoTo SysInfoErr
  100.         Dim rc As Long
  101.         Dim SysInfoPath As String
  102.         
  103.         ' Try To Get System Info Program Path\Name From Registry...
  104.         If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  105.         ' Try To Get System Info Program Path Only From Registry...
  106.         ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  107.                 ' Validate Existance Of Known 32 Bit File Version
  108.                 If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  109.                         SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  110.                         
  111.                 ' Error - File Can Not Be Found...
  112.                 Else
  113.                         GoTo SysInfoErr
  114.                 End If
  115.         ' Error - Registry Entry Can Not Be Found...
  116.         Else
  117.                 GoTo SysInfoErr
  118.         End If
  119.         
  120.         Call Shell(SysInfoPath, vbNormalFocus)
  121.         
  122.         Exit Sub
  123. SysInfoErr:
  124.         MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  125. End Sub
  126. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  127.         Dim i As Long                                           ' Loop Counter
  128.         Dim rc As Long                                          ' Return Code
  129.         Dim hKey As Long                                        ' Handle To An Open Registry Key
  130.         Dim hDepth As Long                                      '
  131.         Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  132.         Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  133.         Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  134.         '------------------------------------------------------------
  135.         ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  136.         '------------------------------------------------------------
  137.         rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  138.         
  139.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  140.         
  141.         tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  142.         KeyValSize = 1024                                       ' Mark Variable Size
  143.         
  144.         '------------------------------------------------------------
  145.         ' Retrieve Registry Key Value...
  146.         '------------------------------------------------------------
  147.         rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  148.                                                 
  149.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  150.         
  151.         If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
  152.                 tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
  153.         Else                                                    ' WinNT Does NOT Null Terminate String...
  154.                 tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
  155.         End If
  156.         '------------------------------------------------------------
  157.         ' Determine Key Value Type For Conversion...
  158.         '------------------------------------------------------------
  159.         Select Case KeyValType                                  ' Search Data Types...
  160.         Case REG_SZ                                             ' String Registry Key Data Type
  161.                 KeyVal = tmpVal                                     ' Copy String Value
  162.         Case REG_DWORD                                          ' Double Word Registry Key Data Type
  163.                 For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  164.                         KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  165.                 Next
  166.                 KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  167.         End Select
  168.         
  169.         GetKeyValue = True                                      ' Return Success
  170.         rc = RegCloseKey(hKey)                                  ' Close Registry Key
  171.         Exit Function                                           '